home *** CD-ROM | disk | FTP | other *** search
/ PC Media 2 / PC MEDIA CD02.iso / share / udos / jacket / jacket.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1991-01-03  |  3.0 KB  |  125 lines
  1. 10  KEY OFF:WIDTH 80:DEF SEG=0:POKE 1047,PEEK(1047) OR 64
  2. 20  DIM TB$(144):DIM AB$(144)
  3. 30  CLS:PRINT:PRINT "What is today's date (Mo/Dy/Yr)";:INPUT DT$
  4. 33  CLS:PRINT:PRINT "What is your name (32 character limit)";:INPUT NAM$
  5. 35  CLS:PRINT:PRINT "What is the jacket name (32 character limit)";:INPUT NS$
  6. 40  CLS:PRINT:PRINT "Which disk drive do you want to list (A/B)";:INPUT DI$:IF DI$<>"A" AND DI$<>"B" THEN 40
  7. 50  REM *** READ DISK MENU ***
  8. 60  BEEP:CLS:PRINT "READING DATA : PLEASE STANDBY"
  9. 70  FSPEC$=DI$+":*.*"
  10. 80  HEAD=1050:TAIL=1052:BUFFER=1054:C=0
  11. 90  ON ERROR GOTO 110
  12. 100  FILES FSPEC$:ON ERROR GOTO 0:GOTO 120
  13. 110  BEEP:CLS:PRINT "CANNOT READ DIRECTORY":ON ERROR GOTO 0:END
  14. 120  DIM TT$(24):LOCATE 3,1:ROWS=0
  15. 130  POKE HEAD,30:POKE TAIL,34:POKE BUFFER,0:POKE BUFFER+1,79:POKE BUFFER+2,13:POKE BUFFER+3,28
  16. 140  LINE INPUT TT$(ROWS):IF TT$(ROWS)<>"" THEN ROWS=ROWS+1:GOTO 130
  17. 150  ROWS=ROWS-1:FOR I=0 TO ROWS:FOR J=0 TO 3
  18. 160  T$=MID$(TT$(I),J*18+1,12)
  19. 170  IF T$<>"" THEN TB$(C)=T$:C=C+1
  20. 180  NEXT J:NEXT I:ERASE TT$
  21. 190  IF C>88 THEN GOSUB 1260
  22. 200  REM *** ALPHABETIZE LISTING ***
  23. 210  BEEP:CLS:PRINT "SORTING DATA : PLEASE STANDBY"
  24. 220  Z$=CHR$(255):E=1
  25. 230  FOR A=0 TO C-1:C$=Z$:FOR B=0 TO C-1:IF C$<TB$(B) THEN 250
  26. 240  C$=TB$(B):D=B
  27. 250  NEXT:AB$(E)=C$:E=E+1:TB$(D)=Z$:NEXT
  28. 410  REM *** JACKET NAME = NS$ ***
  29. 420  GOSUB 2000
  30. 430  REM *** PRINT ALPHA LIST ***
  31. 440  BEEP:CLS:PRINT "PRINTING JACKET : PLEASE STANDBY"
  32. 450  DD=0:CD=INT(C/2)
  33. 460  FOR CR=1 TO 2
  34. 470  LPRINT CHR$(10):REM LINEFEED
  35. 480  NEXT CR
  36. 510  TL$="-"
  37. 520  LPRINT TAB(3);:FOR TL=1 TO 71:LPRINT TL$;:NEXT TL:LPRINT " CUT"
  38. 530  GOSUB 1100:GOSUB 1110
  39. 540  GOSUB 1100
  40. 550  LPRINT TAB(INT(39-LEN(NS$)/2));NS$;
  41. 560  GOSUB 1110
  42. 564  GOSUB 1100
  43. 570  NS$ = NAM$
  44. 572  GOSUB 2000
  45. 575  LPRINT TAB(INT(39-LEN(NS$)/2));NS$;
  46. 580  GOSUB 1110
  47. 585  GOSUB 1100:GOSUB 1110
  48. 600  GOSUB 1100
  49. 610  LPRINT TAB(34);CM$;DT$;"  ";:GOSUB 1110:GOSUB 1120
  50. 620  IF C>32 THEN 790
  51. 630  REM *** PRINT : < 32 PROGRAMS ***
  52. 640  FOR DD=1 TO CD:GOSUB 1100
  53. 650  LPRINT TAB(20);AB$(DD);
  54. 660  LPRINT TAB(45);AB$(CD+DD);
  55. 670  GOSUB 1110
  56. 680  NEXT DD
  57. 690  GOSUB 1100:GOSUB 1110:DD=DD+1
  58. 700  IF DD>17 THEN 720
  59. 710  GOTO 690
  60. 720  GOSUB 1170
  61. 730  FOR SL=1 TO 29
  62. 740  GOSUB 1150:GOSUB 1160
  63. 750  NEXT SL
  64. 760  GOSUB 1190
  65. 770  GOSUB 1210
  66. 780  REM *** PRINT : > 32 PROGRAMS ***
  67. 790  FOR DD=1 TO 16:GOSUB 1100
  68. 800  LPRINT TAB(20);AB$(DD);
  69. 810  LPRINT TAB(45);AB$(DD+16);
  70. 820  GOSUB 1110
  71. 830  NEXT DD
  72. 840  GOSUB 1100:GOSUB 1110
  73. 850  GOSUB 1170
  74. 860  GOSUB 1150:GOSUB 1160
  75. 870  CX=(C-33)/2:CZ=CX+32
  76. 880  FOR DD=33 TO CZ:GOSUB 1150
  77. 890  LPRINT TAB(20);AB$(DD);
  78. 900  LPRINT TAB(45);AB$(DD+CX);
  79. 910  GOSUB 1160
  80. 920  NEXT DD
  81. 930  GOSUB 1150:GOSUB 1160:DD=DD+1
  82. 940  IF DD>60 THEN 960
  83. 950  GOTO 930
  84. 960  GOSUB 1190:GOSUB 1210
  85. 970  REM *** CLOSING REMARKS ***
  86. 980  BEEP:CLS:PRINT "ALPHABETIZED DISK COVER COMPLETE"
  87. 990  PRINT:PRINT "Do you want another disk cover (Y/N)";:INPUT AG$
  88. 1000  FOR DD=0 TO 144:AB$(DD)="":NEXT DD
  89. 1010  IF AG$<>"Y" THEN 1040
  90. 1020  CLS:GOTO 35
  91. 1030  REM ** TERMINATE PROGRAM **
  92. 1040  BEEP:CLS:PRINT "PROGRAM TERMINATED"
  93. 1050  FOR WT=1 TO 1000:NEXT WT
  94. 1060  CLS:END
  95. 1090  REM *** DISK JACKET OUTLINE ***
  96. 1100  LPRINT " :       :  ";:RETURN
  97. 1110  LPRINT TAB(64);"  :       :":RETURN
  98. 1120  LPRINT " :       :  ";
  99. 1130  LPRINT TAB(29);"                    ";
  100. 1140  LPRINT TAB(64);"  :       :":RETURN
  101. 1150  LPRINT "         :";:RETURN
  102. 1160  LPRINT TAB(66);":":RETURN
  103. 1170  CL$="_"
  104. 1180  LPRINT TAB(3);:FOR CL=1 TO 71:LPRINT CL$;:NEXT CL:LPRINT " FOLD":RETURN
  105. 1190  LL$="_"
  106. 1200  LPRINT TAB(11);:FOR LL=1 TO 55:LPRINT LL$;:NEXT LL:LPRINT" CUT":RETURN
  107. 1210  LPRINT:FOR CR=1 TO 3
  108. 1220  LPRINT CHR$(10):REM LINEFEED
  109. 1230  NEXT CR:GOTO 980
  110. 1240  REM ** MENU TOO LONG TO LIST **
  111. 1250  REM ** CAN ONLY LIST 88 PGMS **
  112. 1260  BEEP:CLS:PRINT "TOO MANY PROGRAMS TO LIST ON JACKET"
  113. 1270  PRINT:PRINT "Print those that fit (Y/N)";:INPUT AW$
  114. 1280  IF AW$<>"Y" THEN 1040
  115. 1290  C=88:RETURN
  116. 2000  IF LEN(NS$) > 39 GOTO 2080
  117. 2010  IF LEN(NS$) > 32 GOTO 2060
  118. 2020  NS$ = NS$ +" "
  119. 2030  IF LEN(NS$) > 32 GOTO 2060
  120. 2040  NS$ = " " + NS$
  121. 2050  GOTO 2010
  122. 2060  NS$ = "*" + NS$ + "*"
  123. 2070  GOTO 2000
  124. 2080  RETURN
  125.